home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
AMICUS
/
AMICUS18.ADF
/
Progs
/
StarProbe
/
SPDRAW.BAS
< prev
next >
Wrap
BASIC Source File
|
1989-01-27
|
14KB
|
580 lines
' This program creates visual representations of the data from the StarProbe
' mathematical model. Its structure and organization have been borrowed from
' DeluxDraw (by Rich Wirch).
'
' Allocate enough memory to save entire screen into an array
DEF FNArraySize& = 3+INT((BobRight+16)/16)*(BobBottom+1)*Depth
BobRight = 600: BobBottom = 187 : Depth = 4
Size& = FNArraySize& * 2
IF FRE(0) AND FRE(-1) < Size& THEN PRINT "Not enough memory":END
IF FRE(0) < Size& THEN
CLEAR,Size&+24000
DEF FNArraySize& = 3+INT((BobRight+16)/16)*(BobBottom+1)*Depth
END IF
BobRight = 600: BobBottom = 187 : Depth = 4
DECLARE FUNCTION SetDrMd LIBRARY ' Set the Drawing Mode
DECLARE FUNCTION Move LIBRARY ' Move the Plotting Position
DECLARE FUNCTION Flood LIBRARY ' Flood Fill an Area
DEFINT a-z
DIM SPdata!(1,8) 'Dummy decl; redone when loading data
DIM SelData(8)
DIM Dmin!(8),Dmax!(8),Dtitle$(8),Dcol(8)
MaxVar=7
GOSUB Initialize
GOSUB ReadData
' Main loop - always return here or at next statement
'Main:
'WHILE l<>0: l = MOUSE(0): WEND
Main2:
l = MOUSE(0):x = MOUSE(3):y = MOUSE(4)
y=y-1 'Fix Y to align better with pointer
Mbar = MENU(0)
IF Mbar > 0 THEN
Mitem = MENU(1)
IF Mbar = 1 THEN ' actions
ON Mitem GOSUB ReadData, DataSummary, DrawGraph, Picture, ClearScreen, Quit
ELSEIF Mbar = 2 THEN 'options
ON Mitem GOSUB PlotByMass, PlotByRadius, SmallPicts, LargePict, BaseSemiLog, BaseNormal
ELSEIF Mbar = 3 THEN 'data selection
GOSUB SelectData
END IF
END IF
IF x<0 OR x>WWIDTH OR y<0 OR y>HEIGHT GOTO Main2
IF l <> 0 THEN GOSUB LeftButton
GOTO Main2
LeftButton:
IF x < 220 OR x > 290 THEN RETURN
IF y > 80 THEN RETURN
Mitem = (y\10) + 1
IF Mitem > 8 THEN RETURN
GOSUB SelectData
RETURN
' ----------------- Subroutines -----------------
'
ClearScreen:
LINE (0,0)-(WWIDTH,HEIGHT),1,bf 'clear screen
RETURN
'
PlotByMass:
IndVar = 0
MENU 2,1,2
MENU 2,2,1
RETURN
'
PlotByRadius:
IndVar = 4
MENU 2,1,1
MENU 2,2,2
RETURN
'
SmallPicts:
PictSize=0
MENU 2,4,1
MENU 2,3,2
RETURN
'
LargePict:
PictSize=1
MENU 2,4,2
MENU 2,3,1
RETURN
'
BaseSemiLog:
IF SemiLog=0 THEN
GOSUB ConvertToLog
END IF
GOSUB EvaluateRanges
MENU 2,5,2
MENU 2,6,1
SemiLog=1
RETURN
'
BaseNormal:
IF SemiLog=1 THEN
GOSUB ConvertToNormal
END IF
GOSUB EvaluateRanges
MENU 2,5,1
MENU 2,6,2
SemiLog=0
RETURN
'
DrawGraph:
GOSUB Outline
VarCount = 0
FOR i = 0 TO MaxVar
IF SelData(i) = 1 THEN
x = 10
IF SPdata!(0,i) > SPdata!(GradSteps,i) THEN y=0 ELSE y=180
DepVar = i
VarCount = VarCount + 1
COLOR Dcol(DepVar),1
GOSUB Description
GOSUB PlotIt
END IF
NEXT
GOSUB ResetDataMenu
FOR i = 0 TO MaxVar
SelData(i) = 0
NEXT
RETURN
'
Outline:
GOSUB ClearScreen
COLOR 3,1
LINE (10,1)-(10,180),3 'vert axis
LINE (10,180)-(410,180),3 'horiz axis
FOR x=10 TO 410 STEP 40
LINE (x,182)-(x,178),3'horiz hash marks
NEXT
CALL Move&(RP&, 430,180)
PRINT Dtitle$(IndVar);
RETURN
'
PlotIt:
OldX=x : OldY=y
IndScale!= (Dmax!(IndVar) - Dmin!(IndVar))/400!
DepScale!= (Dmax!(DepVar) - Dmin!(DepVar))/180!
FOR Ind = 0 TO GradSteps
x = 10 + ((SPdata!(Ind,IndVar)-Dmin!(IndVar))/IndScale!)
y = 180 - ((SPdata!(Ind,DepVar)-Dmin!(DepVar))/DepScale!)
LINE (OldX,OldY)-(x,y)
OldX=x : OldY=y
NEXT
RETURN
'
Description:
z = 20 + (VarCount*10)
CALL Move&(RP&, 450, z)
PRINT Dtitle$(DepVar);
RETURN
'
PictDesc:
zy = 10 + ((VarCount\4)*110)
zx = 40 + ((VarCount MOD 4)*130)
CALL Move&(RP&, zx, zy)
PRINT Dtitle$(DepVar);
RETURN
'
Picture:
VarCount=0
GOSUB ClearScreen
FOR i = 2 TO 15' borrow most of the palette
PALETTE i,1!,i/15!,i/15! ' red based
NEXT
IF PictSize=1 THEN rmult = 4 ELSE rmult=1
done=0
FOR DepVar=0 TO MaxVar
IF SelData(DepVar)=1 THEN
IF done = 0 THEN GOSUB DoPict
IF PictSize=1 THEN done=1
VarCount=VarCount+1
END IF
NEXT
GOSUB WaitForMouse
SelData(DepVar)=0:GOSUB ResetDataMenu
GOSUB SetPalette
RETURN
'
DoPict:
IF PictSize=1 THEN
GOSUB Description
ELSE
GOSUB PictDesc
END IF
DepScale!= (Dmax!(DepVar) - Dmin!(DepVar))/13!
r=1
min!=Dmin!(DepVar)
IF PictSize=1 THEN
x0 = WWIDTH\2
y0 = HEIGHT\2
ELSE
x0 = 70 + ((VarCount MOD 4)*130)
y0 = 40 + ((VarCount\4)*110)
END IF
FOR j = 0 TO GradSteps
rnew=r+rmult
hue = 2 + (SPdata!(j,DepVar)-min!)/DepScale!
FOR i = r TO rnew
CIRCLE (x0,y0),i,hue
NEXT
r=rnew
NEXT
RETURN
'
WaitForMouse:
l = MOUSE(0)
WHILE MOUSE(0)=0:WEND
RETURN
'
SelectData:
i=Mitem-1
ON Mitem GOSUB Smass,Spress,Stemp,Slum,Srad,Sdens,Sopcty,Senergy
IF SelData(i)=0 THEN SelData(i)=1 ELSE SelData(i)=0
RETURN
'
Smass:
IF SelData(i) = 1 THEN
MENU 3,1,1
ELSE
MENU 3,1,2
END IF
RETURN
Spress:
IF SelData(i) = 1 THEN
MENU 3,2,1
ELSE
MENU 3,2,2
END IF
RETURN
Stemp:
IF SelData(i) = 1 THEN
MENU 3,3,1
ELSE
MENU 3,3,2
END IF
RETURN
Slum:
IF SelData(i) = 1 THEN
MENU 3,4,1
ELSE
MENU 3,4,2
END IF
RETURN
Srad:
IF SelData(i) = 1 THEN
MENU 3,5,1
ELSE
MENU 3,5,2
END IF
RETURN
Sdens:
IF SelData(i) = 1 THEN
MENU 3,6,1
ELSE
MENU 3,6,2
END IF
RETURN
Sopcty:
IF SelData(i) = 1 THEN
MENU 3,7,1
ELSE
MENU 3,7,2
END IF
RETURN
Senergy:
IF SelData(i) = 1 THEN
MENU 3,8,1
ELSE
MENU 3,8,2
END IF
RETURN
ReadData:
PENDING=4: CANCEL=FALSE: GOSUB GetName ' get a filename
IF FileName$<>"" AND (NOT CANCEL) THEN
OPEN FileName$ FOR INPUT AS 1 LEN=1024
ELSE
PENDING = 0
RETURN
END IF
FOR i = 0 TO MaxVar
Dmin!(i) = 3E+38
Dmax!(i) =-1!
NEXT
INPUT #1,steps
ERASE SPdata!
DIM SPdata!(steps,8)
GradSteps = steps - 1
FOR i = 0 TO GradSteps
FOR j = 0 TO MaxVar
INPUT #1,SPdata!(i,j)
NEXT
NEXT
CLOSE #1
SemiLog=-1 ' bypass conversion
GOSUB BaseNormal
PENDING = 0
RETURN
'
EvaluateRanges:
FOR i = 0 TO GradSteps
FOR j = 0 TO MaxVar
IF SPdata!(i,j) > Dmax!(j) THEN Dmax!(j) = SPdata!(i,j)
IF SPdata!(i,j) < Dmin!(j) THEN Dmin!(j) = SPdata!(i,j)
NEXT
NEXT
GOSUB DataSummary
RETURN
'
ConvertToLog:
cv! = .4343
FOR i = 0 TO GradSteps
FOR j = 0 TO MaxVar
SPdata!(i,j) = cv!*LOG(SPdata!(i,j))
NEXT
NEXT
RETURN
'
ConvertToNormal:
cv! = .4343
FOR i = 0 TO GradSteps
FOR j = 0 TO MaxVar
SPdata!(i,j) = EXP((SPdata!(i,j)/cv!))
NEXT
NEXT
RETURN
'
DataSummary:
GOSUB ClearScreen
COLOR 3,1
CALL Move&(RP&, 150,20): PRINT "Data";
CALL Move&(RP&, 260,20): PRINT "Minimum";
CALL Move&(RP&, 380,20): PRINT "Maximum";
FOR DepVar = 0 TO MaxVar
COLOR Dcol(DepVar),1
y = 40 + (DepVar*10)
CALL Move&(RP&, 150,y): PRINT Dtitle$(DepVar);
CALL Move&(RP&, 250,y): PRINT Dmin!(DepVar);
CALL Move&(RP&, 370,y): PRINT Dmax!(DepVar);
NEXT
RETURN
' File name requestor routine. We'll be looking for mouse
' clicks as well as character input, so use GET versus INPUT
' to receive the file name.
'
GetName:
BobRight = 190: BobBottom = 80
Size&=FNArraySize& \2
DIM SavReq&(Size&)
GET( 50,16)-(240,96), SavReq&
i= 40 'Pop out the requestor box
LINE(90-i,56-i)-(200+i,56+i),2,bf
LINE(50,16)-(240,96),3,b
COLOR 1,2:CALL Move&(RP&,53,35): PRINT Prompt$;
LINE(85,50)-(202,62),3,b
' This little box is the "cursor", in yellow
CURS=88: LINE(CURS,52)-(CURS+7,60),3,bf
LINE(166,74)-(219,86),3,b
COLOR 3,1: CALL Move&(RP&, 169,83): PRINT "Cancel";
CALL Move&(RP&, 60,40): PRINT "Enter data file name";
' Allowable file names (change it to suit your taste):
' First character must be a letter
' Remaining chars may be letters, numbers or . or -
' Maximum of 13 chars
' No two . or - may be adjoining
' No embedded blanks allowed
'
C$=INKEY$: WHILE C$<>"": C$=INKEY$: WEND 'Clear any queued input
FileName$=""
Loop:
C$=INKEY$: l=MOUSE(0): x=MOUSE(1):y=MOUSE(2)
IF l<>0 THEN
WHILE l<>0: l=MOUSE(0): x=MOUSE(1):y=MOUSE(2): WEND 'Wait for button release
' See if we're in the CANCEL box
y=y-1 'For better pointer alignment
IF x>165 AND x<220 AND y>73 AND y<87 THEN
CANCEL=TRUE: PUT(50,16),SavReq&,PSET: ERASE SavReq&: RETURN
END IF
END IF
IF C$="" THEN GOTO Loop
'LINE(75,69)-(183,91),2,b
IF LEN(FileName$)=0 THEN IF C$<"A" AND ASC(C$)<>13 GOTO Loop 'This must be the first character
IF ASC(C$) = 13 THEN '13=Carriage return
PUT( 50,16),SavReq&,PSET: ERASE SavReq&
RETURN
END IF
IF ASC(C$) = 8 THEN '8=Backspace
FileName$=LEFT$(FileName$,LEN(FileName$)-1) 'Shorten name
LINE(CURS,52)-(CURS+7,60),2,bf 'Back up cursor
CURS=CURS-8: LINE(CURS,52)-(CURS+7,60),3,bf
GOTO Loop
END IF
IF LEN(FileName$) >= 13 GOTO Loop 'No more letters
IF RIGHT$(FileName$,1)="." OR RIGHT$(FileName$,1)="-" GOTO Loop
IF ASC(C$)=8 THEN GOTO Loop 'Superfluous backspace
IF C$<"0" OR (C$>"9" AND C$<"A") GOTO Loop
IF (C$>"Z" AND C$<"a") OR C$>"z" GOTO Loop
' Add this letter and advance cursor
FileName$= FileName$ + C$
LINE(CURS,52)-(CURS+7,60),2,bf
COLOR 1,2: CALL Move&(RP&,0,59): PRINT PTAB(CURS);C$;
CURS=CURS+8: LINE(CURS,52)-(CURS+7,60),3,bf
GOTO Loop 'Get another character
InitFile:
FileName$=""
BobRight= WWIDTH-1
BobBottom= HEIGHT-1
PlanePick= MaxColor
RETURN
'
Quit:
LIBRARY CLOSE
WINDOW CLOSE 2
SCREEN CLOSE 1
MENU RESET
END
'--------------------------------------------------
Initialize:
Depth = 4 'Depth =0
'WHILE Depth < 2 or Depth > 5
' INPUT "Select number of bit planes (2-5) ",Depth
'WEND
RES=631 'RES=0
IF Depth = 5 THEN
RES = 311
ELSE
WHILE RES=0
INPUT "Select resolution (Hi/Lo) ", C$
C$=LEFT$(C$,1)
IF C$="H" OR C$="h" THEN RES=631
IF C$="L" OR C$="l" THEN RES=311
WEND
END IF
DIM PAT1%(1),PAT2%(1),PCan!(31,3) : DIM BobArray(1)
RES2=RES/320 'For hi-res aspect ratio for circles
IF RES < 400 THEN scrmode = 1 ELSE scrmode = 2
SCREEN 1, scrmode*320, 200, Depth, scrmode
CLS
WINDOW 2,"StarProbe Analyzer",(0,0)-(RES,186),0,1
WINDOW OUTPUT 2
TRUE=-1: FALSE=0 'For convenience
IF Depth = 5 THEN COLBOX = 6 ELSE COLBOX = 10
' Set colors for Paintbox
PCan!(0,0)= 6/15: PCan!(0,1)= 6/15: PCan!(0,2)= 6/15 'Dark grey
PCan!(1,0)= 0/15: PCan!(1,1)= 0/15: PCan!(1,2)= 0/15 'Black
PCan!(2,0)=10/15: PCan!(2,1)=10/15: PCan!(2,2)=10/15 'Light grey
PCan!(3,0)=15/15: PCan!(3,1)=15/15: PCan!(3,2)=15/15 'White
PCan!(4,0)=15/15: PCan!(4,1)= 9/15: PCan!(4,2)= 9/15 'Pink
PCan!(5,0)=15/15: PCan!(5,1)= 6/15: PCan!(5,2)= 6/15 'Light Red
PCan!(6,0)=15/15: PCan!(6,1)= 2/15: PCan!(6,2)= 2/15 'Red
PCan!(7,0)=12/15: PCan!(7,1)= 0/15: PCan!(7,2)= 14/15 'Purple
PCan!(8,0)= 7/15: PCan!(8,1)=13/15: PCan!(8,2)= 15/15 'Light Blue
PCan!(9,0)= 8/15: PCan!(9,1)= 8/15: PCan!(9,2)= 15/15 'Med. Blue
PCan!(10,0)= 4/15:PCan!(10,1)= 4/15:PCan!(10,2)=15/15 'Dark Blue
PCan!(11,0)= 0/15:PCan!(11,1)=14/15:PCan!(11,2)= 13/15 'Aqua
PCan!(12,0)= 8/15:PCan!(12,1)=12/15:PCan!(12,2)= 8/15 'Light Green
PCan!(13,0)= 4/15:PCan!(13,1)=12/15:PCan!(13,2)= 4/15 'Med. Green
PCan!(14,0)= 0/15:PCan!(14,1)=15/15:PCan!(14,2)= 0/15 'Dark Green
PCan!(15,0)=15/15:PCan!(15,1)=15/15:PCan!(15,2)= 2/15 'Yellow
PCan!(16,0)=0/15: PCan!(16,1)= 4/15: PCan!(16,2)= 4/15 'aquas
PCan!(17,0)=0/15: PCan!(17,1)= 6/15: PCan!(17,2)= 6/15
PCan!(18,0)=0/15: PCan!(18,1)= 8/15: PCan!(18,2)= 8/15
PCan!(19,0)=0/15: PCan!(19,1)=10/15: PCan!(19,2)= 10/15
PCan!(20,0)=0/15: PCan!(20,1)=12/15: PCan!(20,2)= 12/15
PCan!(21,0)=15/15: PCan!(21,1)=15/15: PCan!(21,2)= 2/15 'yellows
PCan!(22,0)=15/15: PCan!(22,1)=15/15: PCan!(22,2)= 4/15
PCan!(23,0)=15/15: PCan!(23,1)=15/15: PCan!(23,2)= 6/15
PCan!(24,0)=15/15: PCan!(24,1)=15/15: PCan!(24,2)= 8/15
PCan!(25,0)=15/15: PCan!(25,1)=15/15: PCan!(25,2)= 10/15
PCan!(26,0)=15/15: PCan!(26,1)=15/15: PCan!(26,2)= 12/15
PCan!(27,0)= 2/15: PCan!(27,1)= 15/15:PCan!(27,2)= 2/15 'greens
PCan!(28,0)= 4/15: PCan!(28,1)= 15/15:PCan!(28,2)= 4/15
PCan!(29,0)= 6/15: PCan!(29,1)= 15/15:PCan!(29,2)= 6/15
PCan!(30,0)= 8/15: PCan!(30,1)= 15/15:PCan!(30,2)= 8/15
PCan!(31,0)= 10/15:PCan!(31,1)= 15/15:PCan!(31,2)= 10/15
GOSUB SetPalette
LIBRARY "graphics.library"
RP& = WINDOW(8) ' Pointer to the Raster Port
W=WINDOW( 2): H=WINDOW(3): WWIDTH=W: HEIGHT=H
' Menu items
MENU 1,0,1,"AstroProject"
MENU 1,1,1,"Read Data "
MENU 1,2,1,"Data Summary"
MENU 1,3,1,"Draw Graphs "
MENU 1,4,1,"Picture "
MENU 1,5,1,"Clear Screen"
MENU 1,6,1,"Quit "
MENU 2,0,1,"Options"
MENU 2,1,1," Plot By Mass "
MENU 2,2,1," Plot By Radius"
MENU 2,3,1," Small Pictures"
MENU 2,4,1," Large Picture "
MENU 2,5,1," Semi-Log Base "
MENU 2,6,1," Regular Base "
MENU 3,0,1,"Select Data"
GOSUB SetDataMenu
MENU 4,0,0,"" ' not used, overlays the fourth menu in amigabasic
' Set default options
GOSUB PlotByRadius
GOSUB SmallPicts
Dtitle$(0) = "Mass"
Dtitle$(1) = "Pressure"
Dtitle$(2) = "Temperature"
Dtitle$(3) = "Luminosity"
Dtitle$(4) = "Radius"
Dtitle$(5) = "Density"
Dtitle$(6) = "Opacity"
Dtitle$(7) = "EnergyRate"
Dcol(0)=3 : Dcol(1)=7 : Dcol(2)=6 : Dcol(3)=11
Dcol(4)=10: Dcol(5)=0 : Dcol(6)=2 : Dcol(7)=15
' Initialize starting values
TextX = 47: TextY = 8
COL = 1 : LASTCOLOR = 0 : MaxColor = 2^Depth - 1 ' Color info
Style = 2: DY = Style - 1: DX = 2 * DY * RES2 ' Style info
SelMass=0:SelPress=0:SelTemp=0:SelLum=0:SelRad=0:SelDens=0
SelOpcty=0:SelEnergy=0
PI!=3.14159
GOSUB InitFile
l = MOUSE(0): x = MOUSE(1): y = MOUSE(2):
RETURN
'
SetDataMenu:
MENU 3,1,1," Mass "
MENU 3,2,1," Press "
MENU 3,3,1," Temp "
MENU 3,4,1," Lum "
MENU 3,5,1," Radius "
MENU 3,6,1," Density"
MENU 3,7,1," Opacity"
MENU 3,8,1," Energy "
RETURN
ResetDataMenu:
MENU 3,1,1
MENU 3,2,1
MENU 3,3,1
MENU 3,4,1
MENU 3,5,1
MENU 3,6,1
MENU 3,7,1
MENU 3,8,1
RETURN
'
SetPalette:
FOR i=0 TO 2^Depth-1: PALETTE i, PCan!( i,0), PCan!( i,1), PCan!( i,2): NEXT
RETURN